home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / delcom / PasMenu / ContextM.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-01-08  |  3.7 KB  |  108 lines
  1. unit ContextM;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;
  7.  
  8. const
  9.    CLSID_ContextMenuShellExtension: TGUID = '{A955FDC0-8819-11D1-AB26-D0E304C10000}';
  10.  
  11. type
  12.     TContextMenu = class (TComObject, IShellExtInit, IContextMenu)
  13.     private
  14.         szFile: array [0..Max_Path] of Char;
  15.     public
  16.         function QueryContextMenu (Menu: hMenu; indexMenu, idCmdFirst, idCmdLast,
  17.                                    uFlags: UInt): HResult; stdcall;
  18.         function InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  19.         function GetCommandString (idCmd, uType: UInt; pwReserved: PUInt;
  20.                                    pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  21.         function Initialize (pidlFolder: PItemIDList; lpdobj: IDataObject;
  22.                                   hKeyProgID: HKEY): HResult; stdcall;
  23.     end;
  24.  
  25. implementation
  26.  
  27. // The Shell calls this method when it's time for the context menu handler to
  28. // add its own custom menu entries to the menu itself.  We return the number
  29. // of entries that we've added.
  30.  
  31. function TContextMenu.QueryContextMenu (Menu: hMenu; indexMenu, idCmdFirst,
  32.                                         idCmdLast, uFlags: uInt): HResult;
  33. begin
  34.     InsertMenu (Menu, indexMenu, mf_String or mf_ByPosition, idCmdFirst, 'View Source');
  35.     Result := 1;
  36. end;
  37.  
  38. // The Shell calls this method when our custom menu item has been clicked by
  39. // the user.  In other words - it's time to do the business...
  40.  
  41. function TContextMenu.InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult;
  42. begin
  43.     // Ensure we're not being called by an application
  44.     Result := E_Fail;
  45.     if HiWord (Integer (lpici.lpVerb)) <> 0 then Exit;
  46.  
  47.     // Verb can only be zero since we only installed one menu item
  48.     Result := E_InvalidArg;
  49.     if LoWord (lpici.lpVerb) <> 0 then Exit;
  50.  
  51.     // Execute the notepad with the specified file
  52.     Result := NoError;
  53.     WinExec (PChar (Format('Notepad %s', [szFile])), lpici.nShow);
  54. end;
  55.  
  56. // The Shell calls this method to get a 'hint' string for the custom menu item
  57.  
  58. function TContextMenu.GetCommandString (idCmd, uType: uInt; pwReserved: puInt;
  59.                                         pszName: LPSTR; cchMax: uInt): HRESULT;
  60. begin
  61.     Result := E_InvalidArg;
  62.     if idCmd = 0 then begin
  63.         strCopy (pszName, 'View selected source file in the Notepad');
  64.         Result := NOERROR;
  65.     end;
  66. end;
  67.  
  68. function TContextMenu.Initialize (pidlFolder: PItemIDList; lpdobj: IDataObject;
  69.                                   hKeyProgID: HKEY): HResult;
  70. var
  71.     medium: TStgMedium;
  72.     fe: TFormatEtc;
  73. begin
  74.     with fe do begin
  75.         cfFormat := CF_HDROP;
  76.         ptd := Nil;
  77.         dwAspect := DVASPECT_CONTENT;
  78.         lindex := -1;
  79.         tymed := TYMED_HGLOBAL;
  80.     end;
  81.  
  82.     // Fail the call if lpdobj is Nil.
  83.     Result := E_Fail;
  84.     if lpdobj = Nil then Exit;
  85.  
  86.     // Render the data referenced by the IDataObject pointer to an HGLOBAL
  87.     // storage medium in CF_HDROP format.
  88.     Result := lpdobj.GetData(fe, medium);
  89.     if Failed (Result) then Exit;
  90.  
  91.     // If only one file is selected, retrieve the file name and store it in
  92.     // szFile. Otherwise fail the call.
  93.     if DragQueryFile (medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  94.     begin
  95.         DragQueryFile (medium.hGlobal, 0, szFile, SizeOf (szFile));
  96.         Result := NOERROR;
  97.     end
  98.     else Result := E_Fail;
  99.  
  100.     ReleaseStgMedium (medium);
  101. end;
  102.  
  103. initialization
  104.     TComObjectFactory.Create (ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
  105.                              '', 'Delphi 3.0 ContextMenu Example', ciMultiInstance);
  106.  
  107. end.
  108.